home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 099 (1989-05-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 099 (1989-05-15)(Ossowski, Stefan)(DE)(PD).adf / PCQ / Examples / MapMaker.p < prev    next >
Text File  |  1989-03-31  |  7KB  |  282 lines
  1. Program MapMaker;
  2.  
  3. {$I "Include/Exec.i"}
  4. {$I "Include/Ports.i"}
  5. {$I "Include/Graphics.i"}
  6. {$I "Include/Intuition.i"}
  7. {$I "Include/DOS.i" solely for the DateStamp thing }
  8.  
  9. {
  10.     This program just draws a blocky map from straight overhead,
  11. then repeatedly splits each block into four parts and adjusts the
  12. elevation of each of the parts until it gets down to one pixel per
  13. block.  It ends up looking something like a terrain map.  It's kind
  14. of a fractal thing, but not too much.  Some program a long time ago
  15. inspired this, but I apologize for forgetting which one.  As I
  16. recall, that program was derived from Chris Gray's sc.
  17.     Once upon a time I was thinking about writing an overblown
  18. strategic conquest game, and this was the first stab at a map
  19. maker.  The maps it produces look nifty, but have no sense of
  20. geology so they're really not too useful for a game.
  21.     When the map is finished, press the left button inside the
  22. window somewhere and the program will go away.
  23. }
  24.  
  25. const
  26.     MinX = 0;
  27.     MaxX = 320;
  28.     MinY = 0;
  29.     MaxY = 200;
  30.  
  31. type
  32.     VerticalArray = array [MinY .. MaxY - 1] of Byte;
  33.     MapArray = array [MinX .. MaxX - 1] of VerticalArray;
  34.  
  35. VAR
  36.     average,x,y,
  37.     nextx,nexty,count,
  38.     skip,level      : Short;
  39.     rp            : RastPortPtr;
  40.     vp            : Address;
  41.     s             : ScreenPtr;
  42.     w             : WindowPtr;
  43.     Seed      : Integer;
  44.     m             : MessagePtr;
  45.     Map           : ^MapArray;
  46.  
  47.  
  48. Function RangeRandom (MaxValue : Integer): Integer;
  49. begin
  50.     Seed := succ(Seed);
  51.     Seed := (Seed * 171) MOD 30269;
  52.     RangeRandom := Seed mod (MaxValue + 1);
  53. end;
  54.  
  55. Procedure SetSeed;
  56. var
  57.     time : DateStampRec;
  58. begin
  59.     DateStamp(time);
  60.     Seed := time.dsDays + time.dsMinute + time.dsTick;
  61. end;
  62.  
  63. Function FixX(x : short): short;
  64. begin
  65.     if x < 0 then
  66.     FixX := x + MaxX
  67.     else
  68.     FixX := x mod MaxX;
  69. end;
  70.  
  71. Function FixY(y : short) : short;
  72. begin
  73.     if x < 0 then
  74.     FixY := y + MaxY
  75.     else
  76.     FixY := y mod MaxY;
  77. end;
  78.  
  79. Procedure DrawMap;
  80. begin
  81.     if skip = 1 then begin
  82.     for x := MinX to MaxX - 1 do begin
  83.         for y := MinY to MaxY - 1 DO begin
  84.         if Map^[x][y] < 0 then begin
  85.             SetAPen(rp, 0);
  86.             WritePixel(rp, x, y)
  87.         end else begin
  88.             average := Map^[x][y] DIV 6 + 1;
  89.             if average > 15 then
  90.             average := 15;
  91.             SetAPen(rp, average);
  92.             WritePixel(rp, x, y)
  93.         end
  94.         end
  95.     end
  96.    end else begin
  97.     for x := MinX to MaxX - 1 by skip do begin
  98.         for y := MinY to MaxY - 1 by skip do begin
  99.         if Map^[x][y] < 0 then begin
  100.             SetAPen(rp, 0);
  101.             RectFill(rp,x,y,x + skip - 1,y + skip - 1)
  102.         end else begin
  103.             average := Map^[x][y] DIV 6 + 1;
  104.             if average > 15 then
  105.             average := 15;
  106.             SetAPen(rp,average);
  107.             RectFill(rp,x,y,x + skip - 1,y + skip - 1);
  108.         end;
  109.         end;
  110.     end;
  111.     end;
  112. end;
  113.  
  114. Function OpenTheScreen() : Boolean;
  115. var
  116.     ns : NewScreenPtr;
  117. begin
  118.     new(ns);
  119.  
  120.     ns^.LeftEdge := 0;
  121.     ns^.TopEdge  := 0;
  122.     ns^.Width    := 320;
  123.     ns^.Height   := 200;
  124.     ns^.Depth    := 4;
  125.     ns^.DetailPen := 3;
  126.     ns^.BlockPen  := 2;
  127.     ns^.ViewModes := 0;
  128.     ns^.SType     := CUSTOMSCREEN_f;
  129.     ns^.Font      := nil;
  130.     ns^.DefaultTitle := nil;
  131.     ns^.Gadgets   := nil;
  132.     ns^.CustomBitMap := nil;
  133.  
  134.     s := OpenScreen(ns);
  135.     dispose(ns);
  136.     OpenTheScreen := s <> nil;
  137. end;
  138.  
  139. Function OpenTheWindow() : Boolean;
  140. var
  141.     nw : NewWindowPtr;
  142. begin
  143.     new(nw);
  144.  
  145.     nw^.LeftEdge := MinX;
  146.     nw^.TopEdge := MinY;
  147.     nw^.Width := MaxX;
  148.     nw^.Height := MaxY;
  149.  
  150.     nw^.DetailPen := -1;
  151.     nw^.BlockPen  := -1;
  152.     nw^.IDCMPFlags := MOUSEBUTTONS_f;
  153.     nw^.Flags := BORDERLESS_f + BACKDROP_f + SMART_REFRESH_f + ACTIVATE_f;
  154.     nw^.FirstGadget := nil;
  155.     nw^.CheckMark := nil;
  156.     nw^.Title := nil;
  157.     nw^.Screen := s;
  158.     nw^.BitMap := nil;
  159.     nw^.MinWidth := 50;
  160.     nw^.MaxWidth := -1;
  161.     nw^.MinHeight := 20;
  162.     nw^.MaxHeight := -1;
  163.     nw^.WType := CUSTOMSCREEN_f;
  164.  
  165.     w := OpenWindow(nw);
  166.     dispose(nw);
  167.     OpenTheWindow := w <> nil;
  168. end;
  169.  
  170. Procedure MakeMap;
  171. begin
  172.  
  173.     rp:= w^.RPort;
  174.     vp:= ViewPortAddress(w);
  175.  
  176.     SetRGB4(vp, 0, 0, 0, 9); { Ocean Blue }
  177.     SetRGB4(vp, 1, 0, 0, 0);
  178.     SetRGB4(vp, 2, 0, 3, 0);
  179.     SetRGB4(vp, 3, 0, 4, 0); { Dark Green }
  180.     SetRGB4(vp, 4, 0, 5, 0);
  181.     SetRGB4(vp, 5, 1, 6, 0);
  182.     SetRGB4(vp, 6, 2, 8, 0); { Medium Green }
  183.     SetRGB4(vp, 7, 4, 10, 0);
  184.     SetRGB4(vp, 8, 6, 10, 0);
  185.     SetRGB4(vp, 9, 9, 9, 0); { Brown }
  186.     SetRGB4(vp, 10, 8, 8, 0);
  187.     SetRGB4(vp, 11, 7, 7, 0); { Dark Brown }
  188.     SetRGB4(vp, 12, 10, 10, 0); { Dark Grey }
  189.     SetRGB4(vp, 13, 10, 10, 10);
  190.     SetRGB4(vp, 14, 12, 12, 12);
  191.     SetRGB4(vp, 15, 14, 14, 15); { White }
  192.  
  193.     SetSeed;
  194.  
  195.     level := 7;
  196.     skip  := 16;
  197.     for y := MinY to MaxY - 1 by skip do
  198.     for x := MinX to MaxX - 1 by skip do
  199.         Map^[x][y] := RangeRandom(220) - 100;
  200.  
  201.     DrawMap;
  202.  
  203.     for level := 2 to 5 do begin
  204.     skip := skip DIV 2;
  205.     for y := MinY to MaxY - 1 by skip do begin
  206.         if (y MOD (2*skip)) = 0 then
  207.         nexty := skip * 2
  208.         else
  209.         nexty:=skip;
  210.         for x := MinX to MaxX - 1 by skip do begin
  211.         if (x MOD (2*skip)) = 0 then
  212.             nextx := skip * 2
  213.         else
  214.             nextx := skip;
  215.         if (nextx = skip * 2) AND (nexty = skip * 2) then begin
  216.             average := Map^[x][y] * 5;
  217.             count := 9;
  218.         end else begin
  219.             average := 0;
  220.             count := 4;
  221.         end;
  222.         if (nextx = skip * 2) then begin
  223.             average := average + Map^[x][FixY(y - skip)];
  224.             average := average + Map^[x][FixY(y + nexty)];
  225.             count := count + 2;
  226.         end;
  227.         if (nexty = skip * 2) then begin
  228.             average := average + Map^[FixX(x - skip)][y];
  229.             average := average + Map^[FixX(x + nextx)][y];
  230.             count := count + 2;
  231.         end;
  232.         average := average + Map^[FixX(x-skip)][FixY(y-skip)]
  233.                    + Map^[FixX(x-nextx)][FixY(y+nexty)]
  234.                    + Map^[FixX(x+skip)][FixY(y-skip)]
  235.                    + Map^[FixX(x+nextx)][FixY(y+nexty)];
  236.         average := (average DIV count) +
  237.                 (RangeRandom(4) - 2) * (9 - level);
  238.         if average > 0 then
  239.             average := average + 1
  240.         else
  241.             average := average - 3;
  242.         if average < -120 then
  243.             average := -120;
  244.         if average > 120 THEN
  245.             average := 120;
  246.         Map^[x][y] := average;
  247.         end;
  248.     end;
  249.     DrawMap;
  250.     end;
  251. end;
  252.  
  253. begin
  254.     GfxBase := OpenLibrary("graphics.library", 0);
  255.     new(Map);
  256.     if GfxBase <> nil then begin
  257.     if OpenTheScreen() then begin
  258.         if OpenTheWindow() then begin
  259.         ShowTitle(s, false);
  260.         MakeMap;
  261.         dispose(Map);
  262.         repeat
  263.             m := GetMsg(w^.UserPort);
  264.         until m = nil;
  265.         m := WaitPort(w^.UserPort);
  266.         Forbid;
  267.         repeat
  268.             m := GetMsg(w^.UserPort);
  269.         until m = nil;
  270.         CloseWindow(w);
  271.         Permit;
  272.         end else
  273.         writeln('Could not open the window.');
  274.         CloseScreen(s);
  275.     end else
  276.         writeln('Could not open the screen.');
  277.     CloseLibrary(GfxBase);
  278.     end else
  279.     writeln('Could not open graphics.library');
  280. end.
  281.  
  282.